<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
<html>
<head>
<title>prim.c</title>
<style type="text/css">
<!--
body.hl	{ background-color:#ffffff; }
pre.hl	{ color:#000000; background-color:#ffffff; font-size:10pt; font-family:'Courier New';}
.hl.num { color:#ff0000; }
.hl.esc { color:#ff22ff; }
.hl.str { color:#ff0000; }
.hl.dstr { color:#ff0000; }
.hl.slc { color:#0000ff; }
.hl.com { color:#0000ff; }
.hl.dir { color:#ff22ff; }
.hl.sym { color:#000000; }
.hl.line { color:#0000ff; }
.hl.mark	{ background-color:#ffffbb;}
.hl.kwa { color:#b26818; }
.hl.kwb { color:#00ff00; }
.hl.kwc { color:#b26818; }
.hl.kwd { color:#000000; }
//-->
</style>
</head>
<body class="hl">
<pre class="hl"><span class="hl com">/*</span>
<span class="hl com"> *  prim.c</span>
<span class="hl com"> *  scheme2</span>
<span class="hl com"> *</span>
<span class="hl com"> *  Created by Leo Katzenstein on 5/26/07.</span>
<span class="hl com"> *  Copyright 2007 __MyCompanyName__. All rights reserved.</span>
<span class="hl com"> *</span>
<span class="hl com"> */</span>

<span class="hl dir">#include</span> <span class="hl dstr">&quot;scheme.h&quot;</span><span class="hl dir"></span>

<span class="hl kwb">static long</span> <span class="hl kwd">suml</span><span class="hl sym">(</span>Pair <span class="hl sym">*</span>l<span class="hl sym">)</span>
<span class="hl sym">{</span>
    <span class="hl kwb">long</span> sum <span class="hl sym">=</span> <span class="hl num">0</span><span class="hl sym">;</span>
    <span class="hl kwa">for</span> <span class="hl sym">(;</span> l<span class="hl sym">;</span> l<span class="hl sym">=</span>l<span class="hl sym">-&gt;</span>cdr<span class="hl sym">)</span>
    <span class="hl sym">{</span>
        <span class="hl kwa">if</span> <span class="hl sym">(</span><span class="hl kwd">is_number</span><span class="hl sym">(</span>l<span class="hl sym">-&gt;</span>car<span class="hl sym">))</span>
            sum <span class="hl sym">+=</span> <span class="hl kwd">nval</span><span class="hl sym">(</span>l<span class="hl sym">-&gt;</span>car<span class="hl sym">);</span>
        <span class="hl kwa">else</span>
            <span class="hl kwd">error</span><span class="hl sym">(</span><span class="hl str">&quot;expected numeric type, got non-numeric type&quot;</span><span class="hl sym">);</span>
    <span class="hl sym">}</span>
    <span class="hl kwa">return</span> sum<span class="hl sym">;</span>
<span class="hl sym">}</span>

<span class="hl kwb">static long</span> <span class="hl kwd">mull</span><span class="hl sym">(</span>Pair <span class="hl sym">*</span>l<span class="hl sym">)</span>
<span class="hl sym">{</span>
    <span class="hl kwb">long</span> prod <span class="hl sym">=</span> <span class="hl num">1</span><span class="hl sym">;</span>
    <span class="hl kwa">for</span> <span class="hl sym">(;</span> l<span class="hl sym">;</span> l<span class="hl sym">=</span>l<span class="hl sym">-&gt;</span>cdr<span class="hl sym">)</span>
    <span class="hl sym">{</span>
        <span class="hl kwa">if</span> <span class="hl sym">(</span><span class="hl kwd">is_number</span><span class="hl sym">(</span>l<span class="hl sym">-&gt;</span>car<span class="hl sym">))</span>
            prod <span class="hl sym">*=</span> <span class="hl kwd">nval</span><span class="hl sym">(</span>l<span class="hl sym">-&gt;</span>car<span class="hl sym">);</span>
        <span class="hl kwa">else</span>
            <span class="hl kwd">error</span><span class="hl sym">(</span><span class="hl str">&quot;expected numeric type, got non-numeric type&quot;</span><span class="hl sym">);</span>
    <span class="hl sym">}</span>
    <span class="hl kwa">return</span> prod<span class="hl sym">;</span>
<span class="hl sym">}</span>

<span class="hl com">/*</span>
<span class="hl com">Pair *fplus( Pair *arglist )</span>
<span class="hl com">{</span>
<span class="hl com">    long sum;</span>
<span class="hl com">    sum = suml( arglist );</span>
<span class="hl com">    return make_num( sum );</span>
<span class="hl com">}</span>
<span class="hl com">*/</span>

Pair <span class="hl sym">*</span><span class="hl kwd">fplus</span><span class="hl sym">(</span>Pair <span class="hl sym">*</span>arglist<span class="hl sym">)</span>
<span class="hl sym">{</span>
    <span class="hl kwb">long</span> sum<span class="hl sym">;</span>
    <span class="hl kwb">double</span> d<span class="hl sym">;</span>

    sum <span class="hl sym">=</span> <span class="hl num">0</span><span class="hl sym">;</span>
    <span class="hl kwa">for</span> <span class="hl sym">(;</span> arglist<span class="hl sym">;</span> arglist <span class="hl sym">=</span> arglist<span class="hl sym">-&gt;</span>cdr<span class="hl sym">)</span>
    <span class="hl sym">{</span>
        <span class="hl kwa">if</span> <span class="hl sym">(</span><span class="hl kwd">is_fixnum</span><span class="hl sym">(</span>arglist<span class="hl sym">-&gt;</span>car<span class="hl sym">))</span>
            sum <span class="hl sym">+=</span> <span class="hl kwd">nval</span><span class="hl sym">(</span>arglist<span class="hl sym">-&gt;</span>car<span class="hl sym">);</span>
        <span class="hl kwa">else</span>
            <span class="hl kwa">goto</span> dbl<span class="hl sym">;</span>
    <span class="hl sym">}</span>
    <span class="hl kwa">return</span> <span class="hl kwd">make_num</span><span class="hl sym">(</span>sum<span class="hl sym">);</span>

dbl<span class="hl sym">:</span>
    d <span class="hl sym">=</span> sum<span class="hl sym">;</span>
    <span class="hl kwa">for</span> <span class="hl sym">(;</span> arglist<span class="hl sym">;</span> arglist <span class="hl sym">=</span> arglist<span class="hl sym">-&gt;</span>cdr<span class="hl sym">)</span>
    <span class="hl sym">{</span>
        <span class="hl kwa">if</span> <span class="hl sym">(</span><span class="hl kwd">is_fixnum</span><span class="hl sym">(</span>arglist<span class="hl sym">-&gt;</span>car<span class="hl sym">))</span>
            d <span class="hl sym">+=</span> <span class="hl kwd">nval</span><span class="hl sym">(</span>arglist<span class="hl sym">-&gt;</span>car<span class="hl sym">);</span>
        <span class="hl kwa">else if</span> <span class="hl sym">(</span><span class="hl kwd">is_double</span><span class="hl sym">(</span>arglist<span class="hl sym">-&gt;</span>car<span class="hl sym">))</span>
            d <span class="hl sym">+=</span> <span class="hl kwd">dval</span><span class="hl sym">(</span>arglist<span class="hl sym">-&gt;</span>car<span class="hl sym">);</span>
        <span class="hl kwa">else</span>
            <span class="hl kwd">error</span><span class="hl sym">(</span><span class="hl str">&quot;expected numeric type, got non-numeric type&quot;</span><span class="hl sym">);</span>
    <span class="hl sym">}</span>
    <span class="hl kwa">return</span> <span class="hl kwd">make_double</span><span class="hl sym">(</span>d<span class="hl sym">);</span>
<span class="hl sym">}</span>

Pair <span class="hl sym">*</span><span class="hl kwd">fminus</span><span class="hl sym">(</span>Pair <span class="hl sym">*</span>arglist<span class="hl sym">)</span>
<span class="hl sym">{</span>
    <span class="hl kwb">long</span> sum<span class="hl sym">;</span>

    <span class="hl kwa">if</span> <span class="hl sym">(</span>arglist <span class="hl sym">==</span> NULL<span class="hl sym">)</span>
        <span class="hl kwd">error</span><span class="hl sym">(</span><span class="hl str">&quot;Error:</span> <span class="hl esc">\&quot;</span><span class="hl str">-</span><span class="hl esc">\&quot;</span> <span class="hl str">got 0 args, wanted at least 1 arg.&quot;</span><span class="hl sym">);</span>

    <span class="hl kwa">if</span> <span class="hl sym">(</span><span class="hl kwd">is_number</span><span class="hl sym">(</span>arglist<span class="hl sym">-&gt;</span>car<span class="hl sym">))</span>
        sum <span class="hl sym">=</span> <span class="hl kwd">nval</span><span class="hl sym">(</span>arglist<span class="hl sym">-&gt;</span>car<span class="hl sym">);</span>
    <span class="hl kwa">else</span>
        <span class="hl kwd">error</span><span class="hl sym">(</span><span class="hl str">&quot;non-numeric type in minus&quot;</span><span class="hl sym">);</span>

    <span class="hl kwa">if</span> <span class="hl sym">(</span>arglist<span class="hl sym">-&gt;</span>cdr <span class="hl sym">==</span> NULL<span class="hl sym">) {</span>
        sum <span class="hl sym">= -</span>sum<span class="hl sym">;</span>     <span class="hl com">/* only one argument */</span>
    <span class="hl sym">}</span> <span class="hl kwa">else</span> <span class="hl sym">{</span>
        sum <span class="hl sym">-=</span> <span class="hl kwd">suml</span><span class="hl sym">(</span>arglist<span class="hl sym">-&gt;</span>cdr<span class="hl sym">);</span>
    <span class="hl sym">}</span>
    <span class="hl kwa">return</span> <span class="hl kwd">make_num</span><span class="hl sym">(</span>sum<span class="hl sym">);</span>
<span class="hl sym">}</span>

Pair <span class="hl sym">*</span><span class="hl kwd">fprod</span><span class="hl sym">(</span>Pair <span class="hl sym">*</span>arglist<span class="hl sym">)</span>
<span class="hl sym">{</span>
    <span class="hl kwb">long</span> prod<span class="hl sym">;</span>
    prod <span class="hl sym">=</span> <span class="hl kwd">mull</span><span class="hl sym">(</span>arglist<span class="hl sym">);</span>
    <span class="hl kwa">return</span> <span class="hl kwd">make_num</span><span class="hl sym">(</span>prod<span class="hl sym">);</span>
<span class="hl sym">}</span>

Pair <span class="hl sym">*</span><span class="hl kwd">fdiv</span><span class="hl sym">(</span>Pair <span class="hl sym">*</span>arglist<span class="hl sym">)</span>
<span class="hl sym">{</span>
    <span class="hl kwb">long</span> prod<span class="hl sym">;</span>

    <span class="hl kwa">if</span> <span class="hl sym">(</span>arglist <span class="hl sym">==</span> NULL<span class="hl sym">)</span>
          <span class="hl kwd">error</span><span class="hl sym">(</span><span class="hl str">&quot;Error:</span> <span class="hl esc">\&quot;</span><span class="hl str">-</span><span class="hl esc">\&quot;</span> <span class="hl str">got 0 args, wanted at least 1 arg.&quot;</span><span class="hl sym">);</span>

    <span class="hl kwa">if</span> <span class="hl sym">(</span><span class="hl kwd">is_number</span><span class="hl sym">(</span>arglist<span class="hl sym">-&gt;</span>car<span class="hl sym">))</span>
        prod <span class="hl sym">=</span> <span class="hl kwd">nval</span><span class="hl sym">(</span>arglist<span class="hl sym">-&gt;</span>car<span class="hl sym">);</span>
    <span class="hl kwa">else</span>
        <span class="hl kwd">error</span><span class="hl sym">(</span><span class="hl str">&quot;non-numeric type in minus&quot;</span><span class="hl sym">);</span>

    <span class="hl kwa">if</span> <span class="hl sym">(</span>arglist<span class="hl sym">-&gt;</span>cdr <span class="hl sym">==</span> NULL<span class="hl sym">) {</span>
        prod <span class="hl sym">=</span> <span class="hl num">1</span> <span class="hl sym">/</span> prod<span class="hl sym">;</span>    <span class="hl com">/* only one argument */</span>
    <span class="hl sym">}</span> <span class="hl kwa">else</span> <span class="hl sym">{</span>
        prod <span class="hl sym">/=</span> <span class="hl kwd">mull</span><span class="hl sym">(</span>arglist<span class="hl sym">-&gt;</span>cdr<span class="hl sym">);</span>
    <span class="hl sym">}</span>
    <span class="hl kwa">return</span> <span class="hl kwd">make_num</span><span class="hl sym">(</span>prod<span class="hl sym">);</span>
<span class="hl sym">}</span>

Pair <span class="hl sym">*</span><span class="hl kwd">fexit</span><span class="hl sym">(</span>Pair <span class="hl sym">*</span>arglist<span class="hl sym">)</span>
<span class="hl sym">{</span>
  <span class="hl kwb">int</span> stat<span class="hl sym">;</span>
  <span class="hl kwa">if</span> <span class="hl sym">(</span>arglist <span class="hl sym">==</span> NULL<span class="hl sym">)</span>
    <span class="hl kwd">error</span><span class="hl sym">(</span><span class="hl str">&quot;Error:</span> <span class="hl esc">\&quot;</span><span class="hl str">-</span><span class="hl esc">\&quot;</span> <span class="hl str">got 0 args, wanted 1 arg.&quot;</span><span class="hl sym">);</span>
  <span class="hl kwa">else if</span> <span class="hl sym">(</span>arglist<span class="hl sym">-&gt;</span>cdr <span class="hl sym">!=</span> NULL<span class="hl sym">)</span>
    <span class="hl kwd">error</span><span class="hl sym">(</span><span class="hl str">&quot;Error:</span> <span class="hl esc">\&quot;</span><span class="hl str">-</span><span class="hl esc">\&quot;</span> <span class="hl str">got 2 or more args, wanted 1 arg.&quot;</span><span class="hl sym">);</span>

  <span class="hl kwa">if</span> <span class="hl sym">(</span>arglist<span class="hl sym">-&gt;</span>car <span class="hl sym">==</span> NULL<span class="hl sym">)</span>
    <span class="hl kwd">exit</span><span class="hl sym">(</span><span class="hl num">1</span><span class="hl sym">);</span>    <span class="hl com">/* exit with null is error */</span>
  <span class="hl kwa">else</span>
    <span class="hl kwd">exit</span><span class="hl sym">(</span><span class="hl num">0</span><span class="hl sym">);</span>
  <span class="hl kwa">return</span> NULL<span class="hl sym">;</span>
<span class="hl sym">}</span>

<span class="hl com">/* equality testing */</span>
Pair <span class="hl sym">*</span><span class="hl kwd">feq</span><span class="hl sym">(</span>Pair <span class="hl sym">*</span>arglist<span class="hl sym">)</span>
<span class="hl sym">{</span>
  Pair <span class="hl sym">*</span>x<span class="hl sym">, *</span>y<span class="hl sym">;</span>
  <span class="hl kwa">if</span> <span class="hl sym">(</span>arglist <span class="hl sym">==</span> NULL <span class="hl sym">||</span>
      arglist<span class="hl sym">-&gt;</span>cdr <span class="hl sym">==</span> NULL <span class="hl sym">||</span>
      arglist<span class="hl sym">-&gt;</span>cdr<span class="hl sym">-&gt;</span>cdr <span class="hl sym">!=</span> NULL <span class="hl sym">)</span>
    <span class="hl kwd">error</span><span class="hl sym">(</span><span class="hl str">&quot;Error: eq wants exactly 2 arguments.&quot;</span><span class="hl sym">);</span>
  x <span class="hl sym">=</span> arglist<span class="hl sym">-&gt;</span>car<span class="hl sym">;</span>
  y <span class="hl sym">=</span> arglist<span class="hl sym">-&gt;</span>cdr<span class="hl sym">-&gt;</span>car<span class="hl sym">;</span>
  <span class="hl kwa">if</span> <span class="hl sym">(</span><span class="hl kwd">is_fixnum</span><span class="hl sym">(</span>x<span class="hl sym">) &amp;&amp;</span> <span class="hl kwd">is_fixnum</span><span class="hl sym">(</span>y<span class="hl sym">) &amp;&amp;</span> <span class="hl kwd">nval</span><span class="hl sym">(</span>x<span class="hl sym">) ==</span> <span class="hl kwd">nval</span><span class="hl sym">(</span>y<span class="hl sym">))</span>
    <span class="hl kwa">return</span> t<span class="hl sym">;</span>
  <span class="hl kwa">else if</span> <span class="hl sym">(</span><span class="hl kwd">is_double</span><span class="hl sym">(</span>x<span class="hl sym">) &amp;&amp;</span> <span class="hl kwd">is_double</span><span class="hl sym">(</span>y<span class="hl sym">) &amp;&amp;</span> <span class="hl kwd">dval</span><span class="hl sym">(</span>x<span class="hl sym">) ==</span> <span class="hl kwd">dval</span><span class="hl sym">(</span>y<span class="hl sym">))</span>
    <span class="hl kwa">return</span> t<span class="hl sym">;</span>
  <span class="hl kwa">else if</span> <span class="hl sym">(</span>x <span class="hl sym">==</span> y<span class="hl sym">)</span>
    <span class="hl kwa">return</span> t<span class="hl sym">;</span>
  <span class="hl kwa">else</span>
    <span class="hl kwa">return</span> NULL<span class="hl sym">;</span>
<span class="hl sym">}</span>
</pre>
</body>
</html>
<!--HTML generated by highlight 2.6.14, http://www.andre-simon.de/-->
